home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 013 / findup30.arc / FINDUP30.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-12-14  |  57.0 KB  |  1,280 lines
  1.  
  2. program FindDuplicateFiles;
  3. {   ╔══════════════════════════════════════════════════════════════════════╗
  4.     ║  Copyright March 25, 1985                                            ║
  5.     ║                                                                      ║
  6.     ║  It must  not be sold to anyone for any purpose it has been placed   ║
  7.     ║  in the public  domain for the use of computer hackers who love to   ║
  8.     ║  play with their machines.                                           ║
  9.     ╠══════════════════════════════════════════════════════════════════════╣
  10.     ║                                                                      ║
  11.     ║                Version 1.0 by Karson Morrison                        ║
  12.     ║                                                                      ║
  13.     ║       Anyone who modifies this program place your name and the new   ║
  14.     ║       version number by it.  Place a comment before and after your   ║
  15.     ║       changes  and  place  the  version  number  as  part of those   ║
  16.     ║       comments.                                                      ║
  17.     ║                                                                      ║
  18.     ║       Please  send  me a copy of the changes that you have made so   ║
  19.     ║       that I may include them in the master.  I don't have all the   ║
  20.     ║       answers I just  started  it.  I am not very knowledgeable at   ║
  21.     ║       Pascal and  I may have made some routines that could be made   ║
  22.     ║       more efficient  by  using  other  coding.  If you find those   ║
  23.     ║       please  let  me  know  and  I  will include them to make the   ║
  24.     ║       program faster.  I cannot make the sort  any  faster because   ║
  25.     ║       it was coded by  Borland.  Anyone  who  sends  me  changes I   ║
  26.     ║       will  include on  a list  that  I will notify of all changes   ║
  27.     ║       that are made to the program.  Keep those cards and  letters   ║
  28.     ║       flowing.                                                       ║
  29.     ╠══════════════════════════════════════════════════════════════════════╣
  30.     ║  This is a program to list out all of the files on a  disk  sorted   ║
  31.     ║  in file order.  It  will  also  tell you of any  duplicate  files   ║
  32.     ║  within different directories.   (See Version 2.0 changes)           ║
  33.     ╠══════════════════════════════════════════════════════════════════════╣
  34.     ║  Requirements:                                                       ║
  35.     ║                                                                      ║
  36.     ║  This program  requires  Turbo  Pascal  2.0  and the Turbo Toolbox   ║
  37.     ║  pascal  program  SORT.BOX.  The .COM  version  has  already  been   ║
  38.     ║  compiled with the SORT in it.                                       ║
  39.     ╠══════════════════════════════════════════════════════════════════════╣
  40.     ║  This program was written by and Copyright (C) 1985 by               ║
  41.     ║                                                                      ║
  42.     ║                              Karson W. Morrison                      ║
  43.     ║                              RD. 1, Box 531,                         ║
  44.     ║                              Ringoes, NJ. 08551                      ║
  45.     ║                              (201) 788-1846                          ║
  46.     ╠══════════════════════════════════════════════════════════════════════╣
  47.     ║  Acknowledgements:                                                   ║
  48.     ║                                                                      ║
  49.     ║  I used info picked up from a  bulletin  board  for  the  routines   ║
  50.     ║  to get system date and time.  That info. was created by  Jon Gray   ║
  51.     ║  of the IBM PC USERS GROUP Milwaukee.  It did have  a  bug  though   ║
  52.     ║  that would only work with months of 2 digits (now fixed by me).     ║
  53.     ║                                                                      ║
  54.     ║  I  also  used  routines  provided  by  Borland for the reading of   ║
  55.     ║  directories. This info was provided in their Turbo Tutor package.   ║
  56.     ║                                                                      ║
  57.     ║  Tears:                                                              ║
  58.     ║                                                                      ║
  59.     ║  A lot of hours went into this program please do not revise it and   ║
  60.     ║  leave out the credit that I have done most of the work.             ║
  61.     ║                                                                      ║
  62.     ║  Purpose:                                                            ║
  63.     ║                                                                      ║
  64.     ║  Every time I turned  around I  was  trying  to delete some of the   ║
  65.     ║  files on my hard disk because I was  always  ending  up with only   ║
  66.     ║  300 - 400 K left.  I kept  thinking  there  must be an easier way   ║
  67.     ║  to know if there were duplicate files.                              ║
  68.     ║                                                                      ║
  69.     ║                     This is the result                               ║
  70.     ╠══════════════════════════════════════════════════════════════════════╣
  71.     ║                Version 2.0   March 25, 1985                          ║
  72.     ║                    Made by the author.                               ║
  73.     ║                                                                      ║
  74.     ║  Updated program to put file size on  each line and put in a major   ║
  75.     ║  option for Sorted Tree Directories.                                 ║
  76.     ║                                                                      ║
  77.     ║  Every Tree Dir program that I have seen always  intersperces  sub   ║
  78.     ║  directories files where it finds them  with  the regular files in   ║
  79.     ║  that directory.  This program  put  files  together,  followed by   ║
  80.     ║  the sub directory files in  that directory.  The sub  directories   ║
  81.     ║  are sorted, and  then  printed  in  the  sorted  order within the   ║
  82.     ║  the parent directory.                                               ║
  83.     ║                                                                      ║
  84.     ║  Updated program to put output on a file DIRECTRY.DTA as an option   ║
  85.     ║  for later printing or other modification.                           ║
  86.     ╠══════════════════════════════════════════════════════════════════════╣
  87.     ║                Version 2.01   April 23, 1985                         ║
  88.     ║                    Made by the author.                               ║
  89.     ║                                                                      ║
  90.     ║  Made a change to increase the valid characters  that may be  in a   ║
  91.     ║  file name.  The 7Fh, DEL  char  may  be  in  a file name there by   ║
  92.     ║  making the file name unable to be entered from the keyboard.        ║
  93.     ║                                                                      ║
  94.     ║  This also is used to make a directory hidden.                       ║
  95.     ║  Fix the line which prints on the screen when a report is being      ║
  96.     ║  produced on paper.                                                  ║
  97.     ╠══════════════════════════════════════════════════════════════════════╣
  98.     ║              Version 2.02  July 28, 1985                             ║
  99.     ║                   Made by the author.                                ║
  100.     ║                                                                      ║
  101.     ║  Made a change to put a Clrscr in at the beginning of the program.   ║
  102.     ║  This was necessary if you use the Public Domain program to reset    ║
  103.     ║  the clear screen at the begining of the program.                    ║
  104.     ║  Turbo 3.0 also doesn't clear screen at beginning of program.        ║
  105.     ╠══════════════════════════════════════════════════════════════════════╣
  106.     ║             Version 2.03 September 9, 1985                           ║
  107.     ║                    Made by the author.                               ║
  108.     ║                                                                      ║
  109.     ║  Made a change to calculate to space used for 1K blocks which is     ║
  110.     ║  what is used when the data is stored on a floppy.                   ║
  111.     ╠══════════════════════════════════════════════════════════════════════╣
  112.     ║             Version 2.04 November 11, 1985                           ║
  113.     ║                     Made by author                                   ║
  114.     ║                                                                      ║
  115.     ║  Made a change to the first screen so that it would be easier to     ║
  116.     ║  understand the options.  Included Windows by Lynn Canning,          ║
  117.     ║  with the original code by Lane Farris.                              ║
  118.     ╠══════════════════════════════════════════════════════════════════════╣
  119.     ║             Version 3.00 December 14, 1985                           ║
  120.     ║                     Made by author                                   ║
  121.     ║  This version now requires Turbo 3.0                                 ║
  122.     ║                                                                      ║
  123.     ║  This version now will read multiple hard disks and floppies and     ║
  124.     ║  do its thing on the file names.                                     ║
  125.     ║                                                                      ║
  126.     ║       Option 1, 2, 4 will allow you to go to the screen, printer     ║
  127.     ║                      or disk file.                                   ║
  128.     ║       Option 3 will only go to disk file 'DIRECTRY.DTA' for the      ║
  129.     ║                directory and 'DUPLICAT.DTA' for the duplicate        ║
  130.     ║                entries.                                              ║
  131.     ║                                                                      ║
  132.     ║       Option 4 Sorted Tree Directory uses the Drive letter as its    ║
  133.     ║                major sort key.  Therefore it will not mix up file    ║
  134.     ║                and directories names from multiple drives.           ║
  135.     ║                                                                      ║
  136.     ║  This version of the program also supports floppies.  The program    ║
  137.     ║  would read them before but the output was not too useful because    ║
  138.     ║  only one floppy could be read at a time.  *** NOW *** the program   ║
  139.     ║  asks you if you are reading a hard drive or a floppy.  Nothing      ║
  140.     ║  happens to the machine if you answer the wrong answer, it is to     ║
  141.     ║  allow me to know if I should VolumeID the disk (I don't on Hard     ║
  142.     ║  Disks).  If you want me to Volume-ID a floppy just enter the data   ║
  143.     ║  (What you enter will also show on the report as the main directory  ║
  144.     ║  If you don't enter a Volume-ID (return) I show the name 'FLOPPYnnn' ║
  145.     ║  as the main directory. (nnn is the number of the diskette entered)  ║
  146.     ║                                                                      ║
  147.     ║  If you want to speed up the entry process, and you have two or more ║
  148.     ║  floppy drives run the program as FINDDUPE AB.  The program will     ║
  149.     ║  alternate between the drives.  (NOTE:) one problem in using this    ║
  150.     ║  feature you must have a floppy for both A and B drives. (You could  ║
  151.     ║  place a blank formatted floppy in the last B: drive to insure       ║
  152.     ║  the completion of the input phase.)                                 ║
  153.     ║                                                                      ║
  154.     ║                                                                      ║
  155.     ║  Included into version 3.00 are changes made by Ray Bobak as he      ║
  156.     ║  noted below.                                                        ║
  157.     ║                                                                      ║
  158.     ║                Version 2.1   October 27, 1985                        ║
  159.     ║                  Modifications by Ray Bobak                          ║
  160.     ║                     Sysop PC-RAIN Node II                            ║
  161.     ║                     Wappingers Falls, NY                             ║
  162.     ║                     914-462-7674 (data)                              ║
  163.     ║                                                                      ║
  164.     ║  Updated code so that the input string from the command line was a   ║
  165.     ║  list of drives to perform the services on.  This change was made    ║
  166.     ║  to allow SYSOP's with multiple download drives to scan all his      ║
  167.     ║  download drives for duplicates.  (Here you go Charlie, your name    ║
  168.     ║  in lights.)  This version was inspired by Charlie Innusa, a sysop   ║
  169.     ║  running RBBS-PC on only nine 32 Megabyte download drives.  You can  ║
  170.     ║  call his BBS, PC-Rockland at 914-353-2157 Subscription node, or     ║
  171.     ║                               914-353-2176 free node                 ║
  172.     ║                                                                      ║
  173.     ║  FINDDUPE ABCDEF - find duplicate files across drives A, B, C, ...   ║
  174.     ║                    approximate time to handle 10K files = 20 Min     ║
  175.     ║                    for reading of directory and sorting.  Note,      ║
  176.     ║                    sort will need 800K of diskspace for the sort.    ║
  177.     ║                                                                      ║
  178.     ╚══════════════════════════════════════════════════════════════════════╝
  179.     ╔══════════════════════════════════════════════════════════════════════╗
  180.     ║  Yours for better Computing                                          ║
  181.     ║                             Karson W. Morrison Caleb Computing Center║
  182.     ╚══════════════════════════════════════════════════════════════════════╝
  183.  
  184.     ╔══════════════════════════════════════════════════════════════════════╗
  185.     ║                                                                      ║
  186.     ║  NOTE:                                                               ║
  187.     ║                                                                      ║
  188.     ║  A command line is used as input if entered else the default drive   ║
  189.     ║  is used.                                                            ║
  190.     ╚══════════════════════════════════════════════════════════════════════╝
  191. }
  192. const
  193.   Max_dir              = 300;   { Max number of directory entries }
  194.                                     { it can be upped }
  195. { Changes for 2.04 }
  196.   MaxWin               = 1;     { Max number of windows open at a time }
  197. { Above Changes for 2.04 }
  198. type
  199.   DirRec =                               { My Sort Record }
  200.     record
  201.         FileDrive      : string[1];      { Drive leter of file} {3.0}
  202.         FileNme        : string[14];     { File Name }
  203.         FileDir        : string[36];     { Concatinated Directory Tree }
  204.         FileAttributes : string[5];      { Codes for System, hidden, dir etc. }
  205.         FileMO         : integer;        { File creation Month }
  206.         FileDA         : integer;        { File creation Day }
  207.         FileYR         : integer;        { File creation Year }
  208.         FileHR         : integer;        { File creation Hour  24 hour clock }
  209.         FileMN         : integer;        { File creation Minute 60 min clock }
  210.         FileSiLow      : integer;        { Low order byte file size }
  211.         FileSiHigh     : integer;        { High order byte file size }
  212.     end;
  213.   String20             = string [ 20 ];
  214.   RegRec =                               { The data to pass to DOS }
  215.     record
  216.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  217.     end;
  218.  
  219. var
  220.   FilVar               : text;                      { Is it CON: or LST: }
  221.   FilVar1              : text;                      { Is it CON: or LST: }
  222.   DirectryRec          : DirRec;
  223.   DiskOutput,                            { Do we want Disk output }
  224.   Print,                                 { Do we want paper or screen }
  225.   FirstTime,                             { First time in this routine }
  226.   DirCont,                               { is this dir on the previous page }
  227.   NotDir               : Boolean;        { This is not a directory rec I read }
  228.   Regs                 : RegRec;         { Dos Registers }
  229.   DTA                  : array [ 1..43 ] of Byte;  { Back from DOS }
  230.   Mask                 : array [ 1..50 ] of Char;  { What do we read DOS calls }
  231.   NamR                 : String20;       { The file name from the DTA }
  232.   timestr              : string[11];     { like it says }
  233.   datestr              : string[15];     {     "        }
  234.   ErrResult,                             { Error Switches }
  235.   Error,
  236.   XDir, YDir, I, Z     : Integer;        { screen position }
  237.   Buffer,                                { Used in file name manipulation }
  238.   Buffer1,                               {               "                }
  239.   Buffer2              : String [50];    {               "                }
  240.   DirTable             : Array [ 1..Max_dir ] of string[50];  { Dirs Found }
  241.   E, E_use,                              { Working integers }
  242.   A, B, C,                               {        "         }
  243.   PageNo               : integer;        { Page being printed }
  244.   OldName              : string [14];    { Work areas for duplicate check }
  245.   OldDir               : string [36];    { Same as DirRec }
  246.   OldAttr              : string[5];           { " }
  247.   OldHi,                                      { " }
  248.   OldLo,                                      { " }
  249.   OldMO,                                      { " }
  250.   OldDA,                                      { " }
  251.   OldYR,                                      { " }
  252.   OldHR,                                      { " }
  253.   OldMN                : integer;             { " }
  254.   OldSI                : real;                { " }
  255.   WrkMN                : string[2];      { Work Month }
  256.   WorkName             : string[14];
  257. { Change for version 2.04  Following Option was changed to Char }
  258.   Option               : char;           { What option did you want from screen }
  259.   Option1              : char;           { What option did you want from screen }
  260.   Option2              : char;           { Is this a Hard Drive or Floppy }
  261. { Above change made for 2.04 }
  262.   HardDrive,                             { Do I have a hard drive or floppies }
  263.   MatchFound           : Boolean;        { Oh! Oh! you have two files the same }
  264.   FloppyNumber,                          { How many floppies have I read }
  265.   ScreenLines          : integer;        { How many lines I've printed }
  266.   ScreenLines1         : integer;        { How many lines I've printed }
  267.   Temp                 : string[1];      { This is not the Temperature }
  268.   SortResult,                            { Did the sort work }
  269.   FileDateDos,                           { Dos format for date }
  270.   FileHourDos,                           { Dos format for Hour }
  271.   FileYear,                              { File Year actual not just since 1980 }
  272.   FileMonth,                             { File month }
  273.   FileDay,                               { File Day }
  274.   FileHour,                              { File Hour }
  275.   FileMinute,                            { File Minute }
  276.   FileWork,                              { Work area }
  277.   FileWork2,                             { Work area }
  278.   FileLow,                               { Work area }
  279.   FileHIgh,                              { Work area }
  280.   NumberRecs           : integer;        { How many records on disk }
  281.   FileWork3            : real;           { Work area for file size }
  282.   DiskUse              : real;           { Work area for Disk space in use }
  283.   FileUse              : integer;        { Work area for file space used }
  284.   FileUse1K            : real;           { Work area if 1K blocks }
  285.   FileUse2K            : real;           { Work area if 2K blocks }
  286.   FileUse4K            : real;           { Work area if 4K blocks }
  287.   FileUseWork          : string[11];     { Work area to print disk use }
  288.   Drive_ctr            : integer;        { Turbo 3.0 Drive letter in use}
  289.   CurDrive             : String[1];      { Turbo 3.0 Current drive }
  290.   DriveString          : string[30];     { Drive string command-line }
  291.   VolumeIdWrite        : string[16];     { VolumeID }
  292.   VolumeIdRead         : string[16];     { VolumeID }
  293.  
  294. { Changes for 2.04 include window }
  295. {$IWindo.INC}
  296. { Above Change for version 2.04 }
  297.  
  298. {$ISORT.BOX}              { This is from Borland in their Toolbox package }
  299.  
  300. procedure date;           { What is todays date }
  301. const
  302.     montharr : array [1..12] of string[3] =
  303.                ('Jan','Feb','Mar','Apr','May',
  304.                 'Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  305.  
  306. var
  307.     regs:regrec;
  308.     month, day:string[2];
  309.     year:string[4];
  310.     dx, cx, result, tmpmonth:integer;
  311.  
  312. begin
  313.     with regs do
  314.     begin
  315.       ax:= $2a shl 8;
  316.     end;
  317.     msdos (regs);
  318.     with regs do
  319.     begin
  320.       str(cx:4, year);
  321.       str(dx shr 8:2, month);
  322.       str(dx mod 256:2, day);
  323.     end;
  324.     if month[1] = ' ' then month[1] := '0';
  325.     val (month, tmpmonth, result);
  326.     datestr:= day + '-' + montharr[tmpmonth] + '-' + year
  327. end; { procedure date }
  328.  
  329. {----------------------------------------------------------------------------}
  330.              { This routine gets the DOS time and makes it look good }
  331.  
  332. { Note:  The Time routine which is used here was picked up on a bulletin
  333.          board and it has some bugs in it when the time was around midnight
  334.          and around noon.  (12 midnight is 12 am and noon is 12 pm)  This
  335.          routine works to the best of my understanding }
  336. { Modified in version 2.05 }
  337.  
  338. procedure time;               { What is the current time }
  339. var                           { Not on your watch! in the computer }
  340.   regs:regrec;
  341.   ah, al, ch, cl, dh:byte;
  342.   hour, min, sec, ampm:string[2];
  343.   tmptime, result:integer;
  344.  
  345. begin
  346.   ah := $2c;
  347.   with regs do
  348.   begin
  349.     ax := ah shl 8 + al;
  350.   end;
  351.   intr($21,regs);
  352.   with regs do
  353.   begin
  354.     str(cx shr 8:2, hour);
  355.     str(cx mod 256:2, min);
  356.     str(dx shr 8:2, sec);
  357.   end;
  358.   if (hour > '11') then
  359.     ampm := 'pm'
  360.   else
  361.     ampm := 'am';
  362.   if (hour < '1') then
  363.     begin
  364.       ampm := 'am';
  365.       hour := '12';
  366.     end;
  367.   if (hour > '12') then
  368.     begin
  369.       val (hour, tmptime, result);
  370.       tmptime:= tmptime - 12;
  371.       str (tmptime:2, hour);
  372.     end;
  373.   if (min[1] = ' ') then
  374.     min[1]:= '0';
  375.   if (sec[1] = ' ') then
  376.     sec[1]:= '0';
  377.   timestr := hour + ':' + min + ':' + sec + ' ' + ampm;
  378. end; { procedure time }
  379.  
  380. {----------------------------------------------------------------------------}
  381.             { This routine reads the volume id in a directory }
  382.      { Written by Karson Morrison Caleb Computing Center  Numbers 13:30 }
  383.  
  384. procedure ReadVolume(DriveWanted:char);
  385. var i,a : integer;
  386. begin
  387.   VolumeIDWrite := DriveWanted + ':\????????.???' + chr(0);
  388.   for i := 1 to length(VolumeIDWrite) do
  389.     Mask[i] := VolumeIDWrite[i];
  390.   VolumeIDRead := '           ';
  391.   Regs.AX := $4E00;             { Get first directory entry }
  392.   Regs.DS := Seg(Mask);         { Point to the file Mask }
  393.   Regs.DX := Ofs(Mask);
  394.   Regs.CX := 8;                 { Store the option for Volume label }
  395.   MSDos(Regs);                  { Execute MSDos call }
  396.   Error := Regs.AX and $FF;     { Get Error return }
  397.   a := 0;
  398.   if error = 0 then
  399.   for i := 1 to 12 do
  400.     if i <> 9 then
  401.       begin
  402.          a := a + 1;
  403.          VolumeIDRead[a] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+i]);
  404.       end;
  405.   for i := 1 to 12 do
  406.     if VolumeIDRead[i] = Chr(0) then
  407.        VolumeIDRead[i] := ' ';
  408.   i := pos(' ',VolumeIDRead);
  409.   if (i <> 0) or (i > 11) then
  410.      VolumeIdRead[0] := Chr(i-1);
  411. end;
  412.  
  413. {----------------------------------------------------------------------------}
  414.             { This routine writes the volume id to a disk }
  415.       { Written by Karson Morrison Caleb Computing Center   Numbers 13:30 }
  416.  
  417. procedure WriteVolume(DriveWanted :char);
  418. var i,a : integer;
  419. begin
  420.   VolumeIDWrite := DriveWanted + ':' + VolumeIDWrite + chr(0);
  421.   a := 0;
  422.   for i := 1 to length(VolumeIDWrite) do
  423.    if i <> 11 then
  424.    begin
  425.      a := a + 1;
  426.      Mask[a] := VolumeIDWrite[i];
  427.    end
  428.    else
  429.    begin
  430.      a := a + 1;
  431.      Mask[a] := '.';
  432.      a := a + 1;
  433.      Mask[a] := VolumeIDWrite[i];
  434.    end;
  435.   Regs.AX := $3C00;             { Create file }
  436.   Regs.DS := Seg(Mask);         { Point to the file Mask }
  437.   Regs.DX := Ofs(Mask);
  438.   Regs.CX := 8;                 { Store the option for Volume label }
  439.   MSDos(Regs);                  { Execute MSDos call }
  440.   Regs.BX := Regs.AX;           { Put file handle in BX }
  441.   Regs.AX := $3E00;             { Close the file }
  442.   MSDos(Regs);                  { Execute MSDos call }
  443.   Error := Regs.AX and $FF;     { Get Error return }
  444. end;
  445.  
  446. {----------------------------------------------------------------------------}
  447.  
  448. procedure SetUpDTA;
  449. begin
  450.   Regs.AX := $1A00;             { Function used to set the DTA }
  451.   Regs.DS := Seg(DTA);          { store the parameter segment in DS }
  452.   Regs.DX := Ofs(DTA);          {   "    "      "     offset in DX }
  453.   MSDos(Regs);                  { Set DTA location }
  454.   Error := Regs.AX and $FF;
  455. end;
  456.  
  457. procedure ReadFirst;
  458. begin
  459.   Regs.AX := $4E00;             { Get first directory entry }
  460.   Regs.DS := Seg(Mask);         { Point to the file Mask }
  461.   Regs.DX := Ofs(Mask);
  462.   Regs.CX := 23;                { Store the option }
  463.   MSDos(Regs);                  { Execute MSDos call }
  464.   Error := Regs.AX and $FF;     { Get Error return }
  465. end;
  466.  
  467. procedure ReadNext;
  468. begin
  469.     Error := 0;
  470.     Regs.AX := $4F00;           { Function used to get the next }
  471.                                 { directory entry }
  472.     Regs.CX := 23;              { Set the file option }
  473.     MSDos( Regs );              { Call MSDos }
  474.     Error := Regs.AX and $FF;   { get the Error return }
  475. end;
  476.  
  477. procedure SetUpNamR;            { Get the file name from the directory }
  478. begin
  479.     repeat
  480.       NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
  481.       I := I + 1;
  482. { Changes for version 2.01 follow this note
  483.      Changes made by the author   }
  484.     until not (NamR[I-1] in [' '..#$7F]) or (I>20); { Note: The second item }
  485.                                      { being compared as in [' '..#$7F] is  }
  486.                                      { the 7Fh char DEL }
  487. { Changes for version 2.01 are in front of this note }
  488.  
  489.   NamR[0] := Chr(I-1);          { set string length because assigning }
  490.                                 { by element does not set length }
  491. end;
  492.  
  493. procedure Set_up_Dir_Chg;       { Get a new directory from the table }
  494. var
  495.   temp : string[50] ;
  496.   temp1 : string[50] ;
  497. begin
  498.     E_use := E_Use + 1;
  499.     temp := DirTable[E_use];
  500.     temp1 := temp;
  501.     if temp[2] <> ':' then
  502.       temp := CurDrive + ':' + temp;
  503.     temp[1] := CurDrive ;
  504.     DirTable[E_use] := temp;
  505.     Buffer := DirTable[E_use] + '\????????.???' + Chr( 0); {3.0}
  506.     Buffer1 := DirTable[E_use];
  507.     GoToXY(1,YDir+1);
  508.     ClrEol;
  509.     Writeln(Buffer1);
  510.     XDir := XDir + 1;
  511.     if XDir > 75 then begin
  512.       XDir := Z;
  513.       Z := Z+1;
  514.     end;
  515.     if Z > 75 then begin
  516.       Z := 26;
  517.       XDir := 25;
  518.     end;
  519.     GoToXY(XDir,YDir);
  520.     if (Z and 1) = 0 then Write('.')     { This puts a . on the screen each }
  521.        else Write('*');                  { This puts a * on the screen each }
  522.     if length(Buffer1) = 1 then Buffer1 := '';
  523.     for I := 1 to length(Buffer) do
  524.       Mask[I] := Buffer[I];
  525. end;
  526.  
  527. procedure FindDate;              { Translate the Date from the Disk to }
  528. begin                            { Something readable }
  529.     FileMonth := 0;              { yyyyyyymmmmddddd  in bits}
  530.     FileDay := 0;
  531.     FileDateDos := MemW[Seg(DTA):Ofs(DTA)+24];
  532.     FileYear := FileDateDos shr 9;  { drop off the last 9 positions }
  533.     FileYear := FileYear + 80;      { years are added to base year of 1980 }
  534.     FileWork := FileDateDos shl 7;  { drop off the first 7 positions }
  535.     FileMonth := FileWork shr 12;   { now move it back to the right }
  536.     FileWork := FileDateDos shl 11; { drop off the left 11 positions }
  537.     FileDay := FileWork shr 11;     { now move back to the right }
  538. end;
  539.  
  540. procedure FindTime;              { Get the time and put it in a format that }
  541. begin                            { we can use. The Dos Format in bits is    }
  542.     FileHour := 0;               { hhhhhmmmmmmsssss }
  543.     FileMinute := 0;
  544.     FileHourDos := MemW[Seg(DTA):Ofs(DTA)+22];
  545.     FileHour := FileHourDos shr 11;     { Shift it around so the minutes and }
  546.     FileWork := FileHourDos shl 5;      { seconds disappear }
  547.     FileMinute := FileWork shr 10;
  548. end;
  549.  
  550. procedure FindSize;              { Get the file size and format it so we can }
  551. begin                            { use it                                    }
  552.     Filelow := MemW[Seg(DTA):Ofs(DTA)+26]; { Get from DTA, Low byte of size }
  553.     FileHigh := MemW[Seg(DTA):Ofs(DTA)+28]; { Get from DTA, High byte        }
  554. end;
  555.  
  556. procedure CalculateSize;
  557. begin
  558.     FileWork := DirectryRec.FileSiLow;
  559.     FileWork2 := Filework shr 15;
  560.     FileWork3 := FileWork2 * 32768.0;       { yes! Save the size             }
  561.     FileWork2 := FileWork shl 1;            { Get rid of high bit            }
  562.     FileWork := FileWork2 shr 1;            { Now back to where we were      }
  563.     FileWork3 := FileWork3 + FileWork;      { Lets add them together         }
  564.     FileWork := DirectryRec.FileSiHigh;
  565.     FileWork3 := FileWork3 + (FileWork * 65536.0);    { Make size total      }
  566. end;
  567.  
  568. procedure PrintDTA;
  569. var
  570.    FileAttr            : Byte;
  571. begin
  572.     FileAttr := Byte(Mem[Seg(DTA):Ofs(DTA)+21]);
  573.     if FileAttr > 31 then        { File Not Archived  But we won't print this }
  574.     begin
  575.       FileAttr := FileAttr - 32;
  576.     end;
  577.     DirectryRec.FileAttributes := '      ';  { Make it all spaces }
  578.     if FileAttr > 15 then        { This is a directory entry      }
  579.     begin                        { Let's do it to it              }
  580.       FileAttr := FileAttr - 16;
  581.       E := E + 1;
  582.       Buffer2 := Buffer1;
  583.       A := Length(Buffer2) + 1;
  584.       B := Length(NamR);
  585.       C := 1;
  586.       Buffer2[A] := '\';
  587.       repeat
  588.         A := A + 1;
  589.         Buffer2[A] := NamR[C];
  590.         C := C + 1;
  591.       until C > B;
  592.       if Buffer2[2]<>':' then
  593.           Buffer2 := CurDrive + ':' + Buffer2;
  594.       Buffer2[0] := Chr(A - 1);
  595.       DirectryRec.FileAttributes[4] := '*';      { Sub Directry }
  596.       DirTable[ E ] := Buffer2;
  597.     end;
  598.     if FileAttr > 7 then
  599.     begin                                    { Volume Labels }
  600.       FileAttr := FileAttr - 8               { don't come back on this call }
  601.     end;
  602.     if FileAttr > 3 then
  603.     begin
  604.       DirectryRec.FileAttributes[3] := 'S';  { System File }
  605.       FileAttr := FileAttr - 4;
  606.     end;
  607.     if FileAttr > 1 then
  608.     begin
  609.        DirectryRec.FileAttributes[2] := 'H'; { Hidden File }
  610.        FileAttr := FileAttr - 2;
  611.     end;
  612.     if FileAttr > 0 then
  613.     begin
  614.        DirectryRec.FileAttributes[1] := 'R'; { Read Only }
  615.     end;
  616. end;
  617.  
  618. procedure FormatAndReleaseSort;  { Yep that is what it is }
  619. begin
  620.      DirectryRec.FileDrive := CurDrive;
  621.      DirectryRec.FileNme := '             ';  { Blank it out }
  622.      DirectryRec.FileNme := NamR;          { Get file name }
  623.      DirectryRec.FileNme[0] := Chr(13);    { Now make it 13 long }
  624.      if HardDrive then
  625.         DirectryRec.FileDir := Buffer1     { Get Directory its in }
  626.      else
  627.         DirectryRec.FileDir := CurDrive + ':' + VolumeIdRead +
  628.             copy(Buffer1,3,48);
  629.      FindDate;                             { Make date readable  }
  630.      FindTime;                             { Time also }
  631.      FindSize;                             { File size }
  632.      DirectryRec.FileMO := FileMonth;      { Complete setting up }
  633.      DirectryRec.FileDA := FileDay;        { Sort Record }
  634.      DirectryRec.FileYR := FileYear;
  635.      DirectryRec.FileHR := FileHour;
  636.      DirectryRec.FileMN := FileMinute;
  637.      DirectryRec.FileSiLow := FileLow;
  638.      DirectryRec.FileSiHigh := FileHigh;
  639.      SortRelease(DirectryRec);             { Let'er go! }
  640. End;
  641.  
  642. function GetDrive : char;
  643. var
  644.   al : byte;
  645.   dr : char absolute al;
  646. begin
  647.   Regs.AX := $19 shl 8;                    { Get current drive letter in AL }
  648.   MsDos(Regs);
  649.   GetDrive := Chr(lo(Regs.AX) + $41);
  650. end;
  651.  
  652. procedure Inp;    { ReadDirs this procedure is forward declared in SORT.BOX }
  653. begin                            { This reads the directories and releases }
  654.                                  { to the sort }
  655.   if ParamCount<>0 then DriveString:=Paramstr(1)
  656.   else
  657.     begin
  658.       DriveString := GetDrive;
  659.     end;
  660.   repeat
  661.     NotDir := True;
  662.     E := 0; E_Use := 0;
  663.     for drive_ctr:=1 to length(DriveString) do
  664.     begin
  665.       E := succ(E);
  666.       CurDrive:=UpCase(DriveString[drive_ctr]);
  667.       Buffer := CurDrive + ':';
  668.       NotDir := True;
  669.       Buffer1 := ''; Buffer2 := Buffer; DirTable[E] := Buffer;
  670.       Buffer[ length(Buffer) + 1 ] := Chr(0);
  671.       Buffer[0] := chr(length(buffer));
  672.       FillChar(DTA,SizeOf(DTA),0);        { Initialize the DTA buffer }
  673.       FillChar(Mask,SizeOf(Mask),0);      { Initialize the mask }
  674.       FillChar(NamR,SizeOf(NamR),0);      { Initialize the file name }
  675.       SetUpDTA;
  676.       Error := 0;
  677.       if not HardDrive then
  678.       begin
  679.          VolumeIdRead := '';
  680.          FloppyNumber := FloppyNumber + 1;
  681.          ReadVolume(CurDrive);
  682.          if error <> 0 then
  683.          begin
  684.             GoToXY(1,20);
  685.             Write('Volume-ID not present.  Drive ',CurDrive,':  ');
  686.             Write('What ID do you want -----------');
  687.             GoToXY(1,21);
  688.             Write('Press return if Volume-ID not wanted!');
  689.             GoToXY(55,20);
  690.             Readln(VolumeIDWrite);
  691.             GoToXY(1,21); ClrEol; GoToXY(1,20); ClrEol;
  692.             if length(VolumeIDWrite) <> 0 then
  693.             begin
  694.                for i := 1 to length(VolumeIDWrite) do
  695.                   VolumeIDWrite[i] := Upcase(VolumeIDWrite[i]);
  696.                VolumeIDRead := VolumeIdWrite;
  697.                WriteVolume(CurDrive);
  698.             end
  699.             else
  700.             begin
  701.                Str(FloppyNumber:3,VolumeIDRead);
  702.                VolumeIDRead := 'Floppy' + VolumeIDRead;
  703.             end;
  704.           end;
  705.       end;
  706.       While E_Use < E do
  707.       begin
  708.            Set_Up_Dir_Chg;
  709.            ReadFirst;                { This does the first read for a directory }
  710.            if (Error = 0) then
  711.            begin
  712.                 I := 1;
  713.                 SetUpNamR;
  714.                 if NamR[1] = '.' then NotDir := False;
  715.                 if NotDir and  (Error = 0) then
  716.                 begin
  717.                     PrintDTA;              { This gets the file attributes }
  718.                     FormatAndReleaseSort;  { Build the record }
  719.                 end;
  720.            end;
  721.            while (Error = 0) do begin
  722.              NotDir := True;
  723.              ReadNext;               { This reads other entries in directory but }
  724.              if (Error = 0) then     { the first }
  725.              begin
  726.                  I := 1;
  727.                  SetUpNamR;
  728.                  if NamR[1] = '.' then NotDir := False; { Is it a dot directory }
  729.                  if NotDir and (Error = 0) then         { No it is not }
  730.                  begin
  731.                      PrintDTA;
  732.                      FormatAndReleaseSort;
  733.                  end;
  734.              end;
  735.            end;
  736.       end;
  737.     end;
  738.   if not HardDrive then
  739.   begin                     { Only ask the following question if floppies }
  740.       GoToXY(1,18); ClrEol;
  741.       Write('Press Return when next floppy ready. (Enter (*) when done!)');
  742.       Read(Kbd,Option1);
  743.       if Option1 <> '*' then
  744.       begin
  745.          GoToXY(1,18); ClrEol;
  746.          Write('Reading the Directories');
  747.       end;
  748.   end
  749.   else
  750.     Option1 := '*';            { This is a hard disk therefore only read once }
  751.   until Option1 = '*';
  752.   Writeln;                       { All done reading the directories }
  753.   Write('Sorting the Directory Data');
  754.   ClrEol;
  755. end;                             { End of procedure Inp  }
  756.  
  757. function Less; { this boolean function has two parameters, X and Y }
  758.               { and is forward declared in SORT.BOX }
  759. var
  760.   FirstDir      : DirRec absolute X;
  761.   SecondDir     : DirRec absolute Y;
  762. begin
  763.   if option = '4' then               { Tree Directory option }
  764.   begin
  765.       Less := (FirstDir.FileDrive < SecondDir.FileDrive)
  766.                              or
  767.              ((FirstDir.FileDrive = SecondDir.FileDrive)                  and
  768.               (FirstDir.FileDir < SecondDir.FileDir))
  769.                              or
  770.              ((FirstDir.FileDrive = SecondDir.FileDrive)                  and
  771.               (FirstDir.FileDir = SecondDir.FileDir)                      and
  772.               (FirstDir.FileAttributes[4] < SecondDir.FileAttributes[4]))
  773.                                   { FileAttr[4] is the sub dir code pos }
  774.                              or
  775.              ((FirstDir.FileDrive = SecondDir.FileDrive)                  and
  776.               (FirstDir.FileDir = SecondDir.FileDir)                      and
  777.               (FirstDir.FileAttributes[4] = SecondDir.FileAttributes[4])  and
  778.               (FirstDir.FileNme < SecondDir.FileNme));
  779.   end
  780.   else                  { Sorted file option }
  781.   begin                                  { this tells the sort which of the }
  782.       Less := (FirstDir.FileNme < SecondDir.FileNme)      { two entries are }
  783.                             or
  784.              ((FirstDir.FileNme = SecondDir.FileNme) and  { first and which }
  785.               (FirstDir.FileDir < SecondDir.FileDir));    { is second }
  786.   end;
  787. end;
  788.  
  789. procedure SetUpOldArea;                  { We need to keep the old }
  790. begin                                    { Stuff around to see if  }
  791.      OldName := DirectryRec.FileNme;     { Matches the new stuff   }
  792.      OldDir  := DirectryRec.FileDir;     { This is used for the duplicate }
  793.      OldAttr := DirectryRec.FileAttributes;  { compares }
  794.      OldDA := DirectryRec.FileDA;
  795.      OldMO := DirectryRec.FileMO;
  796.      OldYR := DirectryRec.FileYR;
  797.      OldHR := DirectryRec.FileHR;
  798.      OldMN := DirectryRec.FileMN;
  799.      CalculateSize;
  800.      OldSI := FileWork3;
  801. end;
  802.  
  803. procedure FixMinute;             { Make the time readable }
  804. begin                            { put a 0 in front of one }
  805.     if length(WrkMN) = 1 then    { character minutes }
  806.     begin
  807.        WrkMN := '0' + WrkMn;
  808.    end;
  809. end;
  810.  
  811. procedure HeadingDupe;           { Headings for the reports }
  812. begin
  813.      PageNo := PageNo + 1;
  814.      Writeln(FilVar,'');
  815.      Write(FilVar,'   Directory list for duplicate files.   ',Datestr,' ',Timestr);
  816.      Writeln(FilVar,'  Page ',PageNo);
  817.      Writeln(FilVar,'      * = Sub Dir: R = Read only; H = Hidden: S = System');
  818.      Writeln(FilVar,'      Files          Date   Time      Size     Directory ');
  819.      WriteLn(FilVar,'');
  820. end;
  821.  
  822. procedure HeadingAll;            { Heading for the reports }
  823. begin
  824.      PageNo := PageNo + 1;
  825.      Writeln(FilVar1,'');
  826.      Write(FilVar1,'      Directory list for all files.      ',Datestr,' ',Timestr);
  827.      Writeln(FilVar1,'  Page ',PageNo);
  828.      Writeln(FilVar1,'      * = Sub Dir: R = Read only: H = Hidden: S = System');
  829.      Writeln(FilVar1,'      Files          Date   Time      Size     Directory ');
  830.      WriteLn(FilVar1,'');
  831. end;
  832.  
  833. procedure HeadingTree;            { Heading for the Tree reports }
  834. begin
  835.      PageNo := PageNo + 1;
  836.      Writeln(FilVar,'');
  837.      Write(FilVar,'  Tree Directory list for all files.      ',Datestr,' ',Timestr);
  838.      Writeln(FilVar,'  Page ',PageNo);
  839.      Writeln(FilVar,'      * = Sub Dir: R = Read only: H = Hidden: S = System');
  840.      Writeln(FilVar,'      Files          Date   Time      Size');
  841. end;
  842.  
  843. procedure OutP; { this procedure is forward declared in SORT.BOX }
  844. begin                            { This takes the sorted data and creates }
  845. { CLRSCR instruction moved later in version 3.00  }
  846.    OldName := '           ';     { Clear out the field }
  847.    NumberRecs := 0;
  848.    OldDir := '            ';
  849.    DirCont := False;
  850.    Buffer[3] := chr(0);          { Shorten the drive identifier here }
  851.    Buffer[0] := chr(2);
  852.    if print then
  853.    begin
  854. { following instruction added in version 3.00  }
  855.        GoToXY(1,19); ClrEol;
  856.        GoToXY(1,18); ClrEol;
  857.        GoToXY(1,17); ClrEol;
  858. { above instruction added in version 3.00  }
  859.        if DiskOutput then
  860.        begin
  861.           Write(' Creating the file DIRECTRY.DTA');
  862.        end
  863.        else
  864.        begin
  865.           Write(' Printing the Report '); { Screen }
  866.        end;
  867.    end
  868. { following instructions were added or moved in version 3.00 }
  869.    else
  870.    begin
  871.        ClrScr;                       { the required reports (Screen or Paper) }
  872.    end;
  873. { above instructions were added or moved in version 3.00  }
  874.    if Option in ['1','3'] then
  875.         HeadingDupe;              { Do you want the Duplicate }
  876.    if Option in ['2','3'] then
  877.         HeadingAll;               { Do you want all the Directories }
  878.    if Option = '4' then
  879.         HeadingTree;              { Do you want the Tree Dir }
  880.    repeat
  881.        SortReturn(DirectryRec);         { Hay it's back, just like magic }
  882.        NumberRecs := NumberRecs + 1;
  883.        CalculateSize;
  884.        DiskUse := DiskUse + FileWork3;
  885.        FileUse := DirectryRec.FileSiLow;  { Lets play with the bits }
  886.  { the following lines of code were entered for 2.03 }
  887.        FileWork := FileUse and 1023;     { Turn off all bits but less than 1K }
  888.        FileWork2 := FileUse shr 10;      { Shift the 1K multiple into place }
  889.        if FileWork <> 0 then                     { If not exact 1K alignment }
  890.           FileUse1K := FileUse1k + FileWork2 + 1  { Then add 1 and save }
  891.        else                                       { If exact 1K alignment }
  892.           FileUse1K := FileUse1K + FileWork2;     { Just keep the multiple }
  893.  { the above lines of code were entered for  2.03 }
  894.        FileWork := FileUse and 2047;     { Turn off all bits but less than 2K }
  895.        FileWork2 := FileUse shr 11;      { Shift the 2K multiple into place }
  896.        if FileWork <> 0 then                     { If not exact 2K alignment }
  897.           FileUse2K := FileUse2k + FileWork2 + 1  { Then add 1 and save }
  898.        else                                       { If exact 2K alignment }
  899.           FileUse2K := FileUse2K + FileWork2;     { Just keep the multiple }
  900.        FileWork := FileUse and 4095;     { Turn off all bits but less then 4K }
  901.        FileWork2 := FileUse shr 12;      { Shift the 4K multiple into place }
  902.        if FileWork <> 0 then                     { If not exact 4K alignment }
  903.           FileUse4K := FileUse4K + FileWork2 + 1  { Then add 1 and save }
  904.        else                                       { If exact 4K alignment }
  905.           FileUse4K := FileUse4K + FileWork2;     { Just keep the multiple }
  906.        FileUse := DirectryRec.FileSiHigh;         { Now get the high byte }
  907. { the folowing line of code was entered for 2.03 }
  908.        FileUse1K := FileUse1K + (FileUse * 64);   { Save the 1K multiple }
  909. { the above line of code was entered for 2.03 }
  910.        FileUse2K := FileUse2K + (FileUse * 32);   { Save the 2K multiple }
  911.        FileUse4K := FileUse4K + (FileUse * 16);   { Save the 4K multiple }
  912.        if Option in ['1','3'] then         { You want the Duplicate entries }
  913.        begin
  914.             WorkName := DirectryRec.FileNme;
  915.             if OldName < WorkName then     { its not duplicate }
  916.             begin
  917.                 SetUpOldArea;
  918.                 if MatchFound then
  919.                 begin
  920.                     MatchFound := False;
  921.                     Writeln(FilVar,'');
  922.                     ScreenLines := ScreenLines + 1;
  923.                 end;
  924.             end
  925.             else                          { Yes it is }
  926.             begin
  927.                 if not MatchFound then
  928.                 begin
  929.                      if ((print) and (ScreenLines > 50))  { 50 on paper is ok }
  930.                       or ((not print) and (ScreenLines > 17)) then
  931.                      begin                     { 17 is about all you want }
  932.                          if print then         { on the screen at a time }
  933.                          begin
  934.                              Writeln(FilVar,#$0C);
  935.                          end
  936.                          else
  937.                          begin
  938.                              Write('                             More');
  939.                              repeat until keypressed;
  940.                                              { I'll wait until you read these }
  941.                              ClrScr;         { Lets start anew }
  942.                          end;
  943.                          HeadingDupe;        { Put the heading back }
  944.                          ScreenLines := 0;   { I got nothing on the screen }
  945.                      end;
  946.                      Write(FilVar,OldAttr);  { Write the old data }
  947.                      Write(FilVar,OldName,' ');
  948.                      Write(FilVar,OldMO:2,'/',OldDA:2,'/',OldYR);
  949.                      Str(OldMN,WrkMN);       { Convert numeric to string }
  950.                      FixMinute;              { now make it more readable }
  951.                      Write(FilVar,' ', OldHR:2,':',WrkMN);
  952.                      Write(FilVar,' ');      { Continue printing }
  953.                      Write(FilVar,OldSI:9:0);  { Print Size }
  954.                      Write(FilVar,' ');      { Continue printing }
  955.                      if length(OldDir) > 0 then   { Is it the main directory }
  956.                          Writeln(FilVar,OldDir)   { Nope }
  957.                      else
  958.                          Writeln(FilVar,'\');   { this is the main directory }
  959.                      ScreenLines := ScreenLines + 1; { Its one more than it was }
  960.                 end;
  961.                 Write(FilVar,DirectryRec.FileAttributes); { Lets write the current }
  962.                 Write(FilVar,DirectryRec.FileNme,' ');    { Record }
  963.                 Write(FilVar,DirectryRec.FileMO:2,'/');
  964.                 Write(FilVar,DirectryRec.FileDA:2,'/');
  965.                 Write(FilVar,DirectryRec.FileYR);
  966.                 Str(DirectryRec.FileMN, WrkMN);
  967.                 FixMinute;
  968.                 Write(FilVar,' ',DirectryRec.FileHR:2,':',WrkMN);
  969.                 Write(FilVar,' ');
  970.                 Write(FilVar,FileWork3:9:0);
  971.                 Write(FilVar,' ');
  972.                 if length(DirectryRec.FileDir) > 1 then
  973.                     Writeln(FilVar,DirectryRec.FileDir)
  974.                 else
  975.                     Writeln(FilVar,'\');      { this is the main directory }
  976.                 ScreenLines := ScreenLines + 1;
  977.                 SetUpOldArea;
  978.                 MatchFound := True;
  979.             end;
  980.        end;
  981.        if Option in ['2','3'] then      { You want them all }
  982.        begin
  983.            if ((print) and (ScreenLines1 > 50))
  984.             or ((not print) and (ScreenLines1 > 18)) then
  985.            begin
  986.                 if print then
  987.                 begin
  988.                     Writeln(FilVar1,#$0C);
  989.                 end
  990.                 else
  991.                 begin
  992.                     Write('                             More');
  993.                     repeat until keypressed;
  994.                     ClrScr;
  995.                 end;
  996.                 HeadingAll;
  997.                 ScreenLines1 := 0;
  998.            end;
  999.            Write(FilVar1,DirectryRec.FileAttributes);
  1000.            Write(FilVar1,DirectryRec.FileNme,' '); { Let's show'em what we found }
  1001.            Write(FilVar1,DirectryRec.FileMO:2,'/');
  1002.            Write(FilVar1,DirectryRec.FileDA:2,'/');
  1003.            Write(FilVar1,DirectryRec.FileYR);
  1004.            Str(DirectryRec.FileMN, WrkMN);
  1005.            FixMinute;
  1006.            Write(FilVar1,' ',DirectryRec.FileHR:2,':',WrkMN);
  1007.            Write(FilVar1,' ');
  1008.            Write(FilVar1,FileWork3:9:0);
  1009.            Write(FilVar1,' ');
  1010.            if length(DirectryRec.FileDir) > 1 then
  1011.                Writeln(FilVar1,DirectryRec.FileDir)
  1012.            else
  1013.                Writeln(FilVar1,'\');
  1014.            ScreenLines1 := ScreenLines1 + 1;
  1015.        end;
  1016.        if Option = '4' then
  1017.        begin
  1018.            if ((print) and (ScreenLines > 50))
  1019.              or ((not print) and (ScreenLines > 18))
  1020.               or ((not print) and (ScreenLines > 15)
  1021.                  and (OldDir <> DirectryRec.FileDir)) then
  1022.            begin
  1023.                 if print then
  1024.                 begin
  1025.                     Writeln(FilVar,#$0C);
  1026.                 end
  1027.                 else
  1028.                 begin
  1029.                     Write('                             More');
  1030.                     repeat until keypressed;
  1031.                     ClrScr;
  1032.                 end;
  1033.                 HeadingTree;
  1034.                 ScreenLines := 0;
  1035.                 if OldDir = DirectryRec.FileDir then
  1036.                 begin
  1037.                    DirCont := True;
  1038.                    OldDir := '         ';
  1039.                 end;
  1040.            end;
  1041.            if OldDir <> DirectryRec.FileDir then   { print the dir were in }
  1042.            begin
  1043.                Writeln(FilVar,'');
  1044.                Write(FilVar,'  Directory ');
  1045.                begin
  1046.                    if length(DirectryRec.FileDir) > 1 then
  1047.                        Write(FilVar,DirectryRec.FileDir)
  1048.                    else
  1049.                        Write(FilVar,'\');
  1050.                end;
  1051.                if DirCont then
  1052.                begin
  1053.                   DirCont := False;
  1054.                   Writeln(FilVar,'    (cont.)');
  1055.                end
  1056.                else
  1057.                Writeln(FilVar,'');
  1058.                OldDir  := DirectryRec.FileDir;
  1059.                Writeln(FilVar,'');
  1060.                ScreenLines := ScreenLines + 3;
  1061.            end;
  1062.            Write(FilVar,DirectryRec.FileAttributes);
  1063.            Write(FilVar,DirectryRec.FileNme,' '); { Let's show'em what we found }
  1064.            Write(FilVar,DirectryRec.FileMO:2,'/');
  1065.            Write(FilVar,DirectryRec.FileDA:2,'/');
  1066.            Write(FilVar,DirectryRec.FileYR);
  1067.            Str(DirectryRec.FileMN, WrkMN);
  1068.            FixMinute;
  1069.            Write(FilVar,' ',DirectryRec.FileHR:2,':',WrkMN);
  1070.            Write(FilVar,' ');
  1071.            Writeln(FilVar,FileWork3:9:0);
  1072.            ScreenLines := ScreenLines + 1;
  1073.        end;
  1074.    until SortEOS;                { Do it until its done }
  1075. end;
  1076.  
  1077.  
  1078. begin                   {  Main program  }
  1079.   ClrScr;
  1080.   Buffer := '';
  1081.   DiskUse := 0;                           { Zero out field }
  1082.   FileUse := 0;                           { Zero out field }
  1083.   FileUse1K := 0;                         { Zero out field }
  1084.   FileUse2K := 0;                         { Zero out field }
  1085.   FileUse4K := 0;                         { Zero out field }
  1086.   FloppyNumber := 0;                      { Zero out fiels }
  1087.   Time;                                   { Get the time }
  1088.   Date;                                   { Get the date }
  1089.   FirstTime := True;                      { First time here }
  1090.   MatchFound := False;                    { Haven't found any matches yet }
  1091.   GoToXY(10,1);                           { Fill the screen with data }
  1092.   Write('Directory List Program   Version 3.00'); { This is it }
  1093.   GoToXY(10,3);
  1094.   Write('Written and Copyright (C) by');
  1095.   GoToXY(18,6);
  1096.   Write('Karson W. Morrison');            { This is who did it }
  1097.   GoToXY(38,7);
  1098.   Write('Caleb Computing Company      Numbers 13:30');
  1099.   GoToXY(38,8);
  1100.   Write('Rd 1, Box 531, Ringoes New Jersey,   08551');
  1101.   GoToXY(18,9);
  1102.   Write('December 14, 1985');                 { And When }
  1103.   GoToXY(10,11);
  1104.   Write('OPTIONS:');
  1105.   GoToXY(11,12);
  1106.   Write('List only Duplicate files on the disk : (1)');
  1107.   GoToXY(11,13);
  1108.   Write('List the entire Directory of the disk : (2)');
  1109.   GoToXY(11,14);
  1110.   Write('List both Directry and Duplicate files: (3)');
  1111.   GoToXY(11,15);
  1112.   Write('List a Sorted Tree Dir of the disk    : (4)');
  1113.   GoToXY(43,22);
  1114.   Write('Partial Mods. for Multiple Hard Disks');
  1115.   GoToXY(58,23);
  1116.   Write('Ray Bobak - 10/27/1985');
  1117.   repeat
  1118.      GoToXY(14,17);
  1119.      Write('Option: ');
  1120.      read(Kbd,Option);
  1121.      GoToXY(22,17);
  1122.      Writeln(Option);
  1123.   until Option in ['1'..'4'];
  1124.  
  1125. { Following Changes made to version 2.04 }
  1126. { I removed some screen information and placed it into a window so that }
  1127. { it made for easier operation }
  1128.   MkWin(20,7,60,13,2,14,1);
  1129.   Print := False;
  1130.   DiskOutput := False;
  1131.   if Option = '3' then
  1132.   begin
  1133.       Print := True;
  1134.       DiskOutput := True;
  1135.       Assign(FilVar,'DUPLICAT.DTA');
  1136.       Assign(FilVar1,'DIRECTRY.DTA');
  1137.       Writeln;
  1138.       Writeln('Duplicate output on DUPLICAT.DTA');
  1139.       Writeln('Directory output on DIRECTRY.DTA');
  1140.       Rewrite(FilVar);
  1141.       Rewrite(FilVar1);
  1142.       TimeDelay(5);                                     { Wait 5 seconds }
  1143.       RmWin;
  1144.   end
  1145.   else
  1146.   begin
  1147.       Writeln(' For Output on printer:------------(P)');
  1148.       Writeln(' For Output in file DIRECTRY.DTA:--(F)');
  1149.       Writeln(' For Output on screen:-------------(S)');
  1150.       Writeln;
  1151.       repeat
  1152.          GoToXY(5,5);
  1153.          Write('Option:');
  1154.          read(Kbd,Option1);
  1155.          Writeln(Upcase(Option1));
  1156.       until Upcase(Option1) in ['P','F','S'];
  1157.       RmWin;
  1158. { Above lines of code were put in for window and to make the messages easier }
  1159. { to understand }
  1160.       if Upcase(Option1) = 'P' then
  1161.       begin                          { Set up printer for listing }
  1162.           Print := True;
  1163.           if Option in ['1','4'] then
  1164.           begin
  1165.              Assign(FilVar,'LST:');
  1166.              Rewrite(FilVar);
  1167.           end
  1168.           else
  1169.           begin
  1170.              Assign(FilVar1,'LST:');
  1171.              Rewrite(Filvar1);
  1172.           end;
  1173.       end;
  1174.       if Upcase(Option1) = 'F' then
  1175.       begin                          { Set up file for listing }
  1176.           Print := True;
  1177.           DiskOutput := True;
  1178.           if Option in ['1','4'] then
  1179.           begin
  1180.              Assign(FilVar,'DIRECTRY.DTA');
  1181.              Rewrite(FilVar);
  1182.           end
  1183.           else
  1184.           begin
  1185.              Assign(FilVar1,'DIRECTRY.DTA');
  1186.              Rewrite(Filvar1);
  1187.           end;
  1188.       end;
  1189.       if Upcase(Option1) = 'S' then
  1190.       begin                          { Set up file for listing }
  1191.           if Option in ['1','4'] then
  1192.           begin
  1193.              Assign(FilVar,'CON:');
  1194.              Rewrite(FilVar);
  1195.           end
  1196.           else
  1197.           begin
  1198.              Assign(FilVar1,'CON:');
  1199.              Rewrite(Filvar1);
  1200.           end;
  1201.       end;
  1202.   end;
  1203.   MkWin(20,7,60,13,2,14,1);
  1204.   Writeln('Are you running this program against');
  1205.   Writeln('Floppies or a Hard Disk?  (F or H)');
  1206.   Writeln;
  1207.   Write('Option: ');
  1208.   Repeat
  1209.     Read(kbd,Option2);
  1210.   until (Upcase(Option2)) in ['F','H'];
  1211.   if Upcase(Option2) = 'H' then
  1212.      HardDrive := true
  1213.   else
  1214.      HardDrive := false;
  1215.   RmWin;
  1216.   Writeln;
  1217.   ScreenLines := 0;
  1218.   ScreenLines1 := 0;
  1219.   PageNo := 0;
  1220.   GoToXY(1,18);
  1221.   XDir := 25; YDir := 18; Z := 26;
  1222.   Writeln('Reading the Directories');
  1223.   Write('\');
  1224.   SortResult := TurboSort(SizeOf(DirectryRec)); { this does the call to the sort }
  1225.   if SortResult > 1 then                    { if the sort don't work   }
  1226.   begin                                     { This maybe what is wrong }
  1227.       if SortResult = 3 then Writeln('Not enouth memory for sorting');
  1228.       if SortResult = 9 then Writeln('More than 32767 records being sorted');
  1229.       if sortresult = 10 then Writeln('Disk error during sorting (bad or full)');
  1230.       if SortResult = 11 then Writeln('Read error during sort (Probably bad disk)');
  1231.       if sortResult = 12 then Writeln('File creation error (directory may be full)');
  1232.   end;
  1233.   Writeln;
  1234.   if print then
  1235.   begin
  1236.       if Option in ['1','3','4'] then
  1237.       begin
  1238.           Writeln(FilVar,'');
  1239.           Write(FilVar,'  Number of Directories: ',E-1);
  1240.           Writeln(FilVar,'  Number of Files: ',NumberRecs-E+1);
  1241.           Writeln(FilVar,'  Disk Space used           ',DiskUse:11:0);
  1242.           Writeln(FilVar,'  Disk Space used 4K blocks ',(FileUse4K * 4096.0):11:0);
  1243.           Writeln(FilVar,'  Disk Space used 2K blocks ',(FileUse2K * 2048.0):11:0);
  1244.           Writeln(FilVar,'  Disk Space used 1K blocks ',(FileUse1K * 1024.0):11:0);
  1245.           If not DiskOutput then
  1246.              Writeln(FilVar,#$0C);
  1247.       end;
  1248.       if Option in ['2','3'] then
  1249.       begin
  1250.           Writeln(FilVar1,'');
  1251.           Write(FilVar1,'  Number of Directories: ',E-1);
  1252.           Writeln(FilVar1,'  Number of Files: ',NumberRecs-E+1);
  1253.           Writeln(FilVar1,'  Disk Space used           ',DiskUse:11:0);
  1254.           Writeln(FilVar1,'  Disk Space used 4K blocks ',(FileUse4K * 4096.0):11:0);
  1255.           Writeln(FilVar1,'  Disk Space used 2K blocks ',(FileUse2K * 2048.0):11:0);
  1256.           Writeln(FilVar1,'  Disk Space used 1K blocks ',(FileUse1K * 1024.0):11:0);
  1257.           If not DiskOutput then
  1258.              Writeln(FilVar1,#$0C);
  1259.       end;
  1260.  
  1261. { the following line was changed in version 3.00 }
  1262.       GoToXY(1,19);   { this is for the Writeln below this }
  1263.   end;
  1264.   If DiskOutput then
  1265.   begin
  1266.      if Option in ['1','3','4'] then
  1267.         close(FilVar);
  1268.      if Option in ['2','3'] then
  1269.         close(Filvar1);
  1270.   end;
  1271.   Write('  Number of Directories: ',E-1);
  1272.   Write('  Number of Files: ',NumberRecs-E+1);
  1273.   ClrEol;
  1274.   Writeln;
  1275.   Writeln('  Disk Space used           ',DiskUse:11:0);
  1276.   Writeln('  Disk Space used 4K blocks ',(FileUse4K * 4096.0):11:0);
  1277.   Writeln('  Disk Space used 2K blocks ',(FileUse2K * 2048.0):11:0);
  1278.   Writeln('  Disk Space used 1K blocks ',(FileUse1K * 1024.0):11:0);
  1279. end.
  1280.